home *** CD-ROM | disk | FTP | other *** search
/ Merciful 4 / Merciful - Disc 4.iso / rexx / loadanimgif.pprx < prev    next >
Text File  |  1996-11-01  |  6KB  |  245 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: LoadAnimGif.pprx 1.0 */
  4.  
  5. /** ENG
  6.  This script loads a GIF animation, and then either displays it with the
  7.  proper timing, or converts it into an IFF anim-brush (if the "Anim-Brush"
  8.  option is selected).
  9.  
  10.  GIF animation features such as frame-by-frame timing, multiple palettes,
  11.  control blocks, offsets and overlays are supported. Multiple transparencies
  12.  are not supported.
  13. */
  14.  
  15. /** DEU
  16.  Mit Hilfe dieses Skripts läßt sich eine GIF-Animation laden und dann
  17.  entweder mit dem korrekten Timing anzeigen oder in einen IFF-Anim-Brush
  18.  konvertieren (sofern die Option "Anim-Brush" aktiviert ist).
  19.  
  20.  Merkmale von GIF-Animationen, wie frameweises Timing, unterschiedliche
  21.  Paletten, Control Blocks, Offsets und Overlays werden unterstützt.
  22.  Unterschiedliche Transparenzwerte werden nicht unterstützt.
  23. */
  24.  
  25. IF ARG(1, EXISTS) THEN
  26.     PARSE ARG PPPORT
  27. ELSE
  28.     PPPORT = 'PPAINT'
  29.  
  30. IF ~SHOW('P', PPPORT) THEN DO
  31.     IF EXISTS('PPaint:PPaint') THEN DO
  32.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  33.         DO 30 WHILE ~SHOW('P',PPPORT)
  34.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  35.         END
  36.     END
  37.     ELSE DO
  38.         SAY "Personal Paint could not be loaded."
  39.         EXIT 10
  40.     END
  41. END
  42.  
  43. IF ~SHOW('P', PPPORT) THEN DO
  44.     SAY 'Personal Paint Rexx port could not be opened'
  45.     EXIT 10
  46. END
  47.  
  48. ADDRESS VALUE PPPORT
  49. OPTIONS RESULTS
  50. OPTIONS FAILAT 10000
  51.  
  52. Get 'LANG'
  53. IF RESULT = 1 THEN DO        /* Deutsch */
  54.     txt_title_req     = 'GIF-Anim-Brush laden'
  55.     txt_gad_absh      = 'Anim-_Brush:'
  56.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  57.     txt_err_oldlib    = 'Für dieses Skript ist eine neuere Version_der GIF library erforderlich'
  58.     txt_err_load      = 'Fehler beim Laden'
  59.     txt_err_notagif   = 'Die ausgewählte Datei enthält keine GIF-Animation'
  60.     txt_err_notsupp   = 'Das ausgewählte Animationsformat kann nicht geladen werden.'
  61. END
  62. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  63.     txt_title_req     = 'Leggere Anim-brush GIF'
  64.     txt_gad_absh      = 'Anim-_Brush:'
  65.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  66.     txt_err_oldlib    = 'Questa procedura richiede_una versione più recente_della libreria GIF'
  67.     txt_err_load      = 'Errore nelle lettura del file'
  68.     txt_err_notagif   = 'Il file selezionato_non contiene un''animazione GIF'
  69.     txt_err_notsupp   = 'Il tipo di animazione non può essere letto'
  70. END
  71. ELSE DO                /* English */
  72.     txt_title_req     = 'Load GIF Anim-Brush'
  73.     txt_gad_absh      = 'Anim-_Brush:'
  74.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  75.     txt_err_oldlib    = 'This script requires a newer_version of the GIF library'
  76.     txt_err_load      = 'Load error'
  77.     txt_err_notagif   = 'The selected file_does not contain_a GIF animation'
  78.     txt_err_notsupp   = 'The selected animation type_cannot be loaded'
  79. END
  80.  
  81. Version 'REXX'
  82. IF RESULT < 7 THEN DO
  83.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  84.     EXIT 10
  85. END
  86.  
  87. LockGUI
  88. RequestFile '"'txt_title_req'"'
  89. IF RC = 0 THEN DO
  90.     gfile = RESULT
  91.     getbsh = LoadSet('GetBsh', 1)
  92.  
  93.     Request '"'txt_title_req'" "CHECK = ""'txt_gad_absh'"", 'getbsh'"'
  94.     IF RC = 0 THEN DO
  95.         getbsh = RESULT.1
  96.         CALL SaveSet('GetBsh', getbsh)
  97.         frame = 1
  98.         loop = -1
  99.         delays = ''
  100.         err_msg = ''
  101.         setup = 1
  102.  
  103.         Get 'GCLIP'
  104.         saveclip = RESULT
  105.         Set '"GCLIP=0"'
  106.  
  107.         DO FOREVER
  108.             LoadBrush gfile 'QUIET NOPROGRESS FORMAT "GIF" OPTIONS "FRAME='frame'"'
  109.             IF RC = 0 THEN DO
  110.                 IF setup THEN DO
  111.                     setup = 0
  112.                     SwitchEnvironment
  113.                     FreeEnvironment 'QUERY'
  114.                     IF RC ~= 0 THEN
  115.                         LEAVE
  116.                     DeleteFrames 'ALL FORCE'
  117.                     SetPen 'BACKGROUND 0'
  118.                     ClearImage
  119.                     GetBrushAttributes 'COLORS'
  120.                     cnum = RESULT
  121.                     GetBrushAttributes 'WIDTH'
  122.                     brushw = RESULT
  123.                     GetBrushAttributes 'HEIGHT'
  124.                     brushh = RESULT
  125.                     GetBestVideoMode brushw brushh cnum 'ANIMATION'
  126.                     PARSE VAR RESULT scrd scrw scrh
  127.                     Set '"IMAGEW='brushw'" "IMAGEH='brushh'" "COLORS='cnum'" "DISPLAY='scrd'" "SCREENW='scrw'" "SCREENH='scrh'" "ASCROLL=0"'
  128.                     IF RC ~= 0 THEN
  129.                         LEAVE
  130.                     GetBrushAttributes 'TRANSPARENCY'
  131.                     transp = RESULT
  132.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  133.                     transpcol = RESULT
  134.                     SetPen 'BACKGROUND' transpcol
  135.                     ClearImage
  136.                     AddFrames
  137.                 END
  138.                 ELSE DO
  139.                     GetBrushAttributes 'TRANSPARENCY'
  140.                     transp2 = RESULT
  141.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  142.                     transpcol2 = RESULT
  143.                     IF transp2 ~= transp | transpcol2 ~= transpcol THEN DO
  144.                         err_msg = txt_err_notsupp
  145.                         LEAVE
  146.                     END
  147.                 END
  148.                 UseBrushPalette
  149.                 SetPaintMode 'REPLACE'
  150.                 SetBrushAttributes 'HANDLEX 0 HANDLEY 0'
  151.                 PutBrush 0 0
  152.  
  153.                 GetBrushInfo 'ANNOTATION'
  154.                 IF RC = 0 THEN DO
  155.                     PARSE VALUE RESULT WITH 'LOOP ' loop ' DELAY ' delay .
  156.                     IF DATATYPE(delay, 'W') THEN DO
  157.                         delays = delays delay
  158.                         ticks = TRUNC(delay / 100 * 60 + 0.5)
  159.                         SetFrameDelay ticks
  160.                     END
  161.                 END
  162.  
  163.                 AddFrames
  164.                 SetFramePosition 'NEXT'
  165.                 frame = frame + 1
  166.             END
  167.             ELSE DO
  168.                 IF RC = 38 THEN
  169.                     err_msg = txt_err_notagif
  170.                 ELSE IF RC = 47 THEN
  171.                     err_msg = txt_err_oldlib
  172.                 ELSE IF RC ~= 39 THEN
  173.                     err_msg = txt_err_load
  174.                 LEAVE
  175.             END
  176.         END
  177.  
  178.         IF frame <= 2 & err_msg = '' THEN
  179.             err_msg = txt_err_notagif
  180.  
  181.         LoadBrush gfile 'QUIET NOPROGRESS FORMAT "AUTO"'    /* reset to normal load */
  182.         FreeBrush 'FORCE'
  183.         DeleteFrames
  184.  
  185.         IF err_msg ~= '' THEN DO
  186.             RequestNotify 'PROMPT "'err_msg'"'
  187.             FreeEnvironment 'FORCE'
  188.         END
  189.         ELSE DO
  190.             SetFramePosition 1
  191.             IF getbsh THEN DO
  192.                 Get 'TRANSP'
  193.                 sv_transp = RESULT
  194.  
  195.                 IF transp = 1 THEN
  196.                     Set '"TRANSP=' transp '"'
  197.                 ELSE
  198.                     Set '"TRANSP=0"'
  199.  
  200.                 GetFrames
  201.                 DefineBrush 0 0 brushw-1 brushh-1 RESULT
  202.                 IF RC = 0 THEN DO
  203.                     FreeEnvironment 'FORCE'
  204.                     SetBrushInfo 'ANNOTATION "LOOP' loop 'DELAY' delays'"'
  205.                 END
  206.  
  207.                 Set '"TRANSP=' sv_transp '"'
  208.             END
  209.             ELSE Play 'FORCE'
  210.         END
  211.         Set '"GCLIP='saveclip'"'
  212.     END
  213. END
  214. UnlockGUI
  215.  
  216. EXIT 0
  217.  
  218.  
  219.  
  220.  
  221. SaveSet: PROCEDURE
  222.     sname = ARG(1)
  223.     val = ARG(2)
  224.  
  225.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'W') THEN DO
  226.         CALL WRITECH('settingfile', val)
  227.         CALL CLOSE('settingfile')
  228.     END
  229.  
  230.     RETURN
  231.  
  232.  
  233.  
  234.  
  235. LoadSet: PROCEDURE
  236.     sname = ARG(1)
  237.     val = ARG(2)
  238.  
  239.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'R') THEN DO
  240.         val = READCH('settingfile', 65535)
  241.         CALL CLOSE('settingfile')
  242.     END
  243.  
  244.     RETURN val
  245.